/* REXX _eprobe.zrx by the reverend (build 108)                               */
/*-       built by rev-builder version 1.1 on 02 Jan 2003 at 11:11:22        -*/
/*- ------------------------------------------------------------------------ -*/
/*-                       Copyright (C) 2001 Ron Wilson                      -*/
/*-                                                                          -*/
/*- This script is free, and can be modified for your personal use, but you  -*/
/*- cannot copy or distribute this script or any derivative work based upon  -*/
/*- this script without the express permission of the author. Your use of    -*/
/*- this script is governed by the terms of the REV-LICENSE.                 -*/
/*-                                                                          -*/
/*- This program is provided to you WITHOUT ANY WARRANTY, even the implied   -*/
/*- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -*/
/*- REV-LICENSE for more details.                                            -*/
/*-                                                                          -*/
/*-                A copy of the REV-LICENSE is available at:                -*/
/*-       http://thereverend.coastgames.com/tradewars/rev-license.html       -*/
/*- ------------------------------------------------------------------------ -*/
/* description:  eprobe the universe the easy way. do a random search or only */
/*               probe sectors you have not visited yet. automatically buys   */
/*               more eprobes if you are at stardock.                         */
/* rev. 0 - initial release                                                   */
/* rev. 1 - minor bug fixes                                                   */
/* rev. 2 - minor bug fixes                                                   */

call zoctimeout 60
call zocsynctime 500
globals=_setglobals(debug)
call on halt name _halt
call zockeyboard "LOCK"
call _rseed

debug=0

if \_pcheck("Command [") then call _error "please start at the command prompt."

rmask="0PST"
mins=1
maxs=20000
target=0

if debug then call _debug "LOG", "EPROBE SESSION: "||date("N")||", "||time("N")

/* GET EPROBE MODE */
mode=_chooselist("select a probe method:", "RANDOM;UNEXPLORED;FILE", ";", "c")
select
 when mode="RANDOM" then nop
 when mode="UNEXPLORED" then target=_asknum("start at what sector?", 1, "c")-1
 when mode="FILE" then do
  parse value zocgetglobaloption("ScriptPath") with . '="' fpath '"'
  fpath=fpath||"\"
  fname="*.txt"
  fname=zocgetfilename("enter sector list filename:", fpath||fname)
  if fname="##CANCEL##" then call _quit "script cancelled by user."
  if \_fileexists(fname) then call _error fname||" does not exist."
  if \_fileopenr(fname) then call _error "unable to open file "||fname||"."
 end /*when*/
end /*select*/

/* GET REPORT MODE */
rmode=_chooselist("select a report mode:", "SUBSPACE;FILE;BOTH;NONE", ";", "c")
if rmode="FILE" | rmode="BOTH" then do
 parse value zocgetglobaloption("DownloadAltPath") with . '="' rpath '"'
 rpath=rpath||"\"
 rname="report.txt"
 rname=zocask("enter report filename:", rname)
 if rname="##CANCEL##" then call _quit "script cancelled by user."
 if pos(".",rname)=0 then rname=rname||".txt"
 rname=rpath||rname
end /*if*/
else rname=""
select
 when rmode="SUBSPACE" then rmode="sub"
 when rmode="FILE" then rmode="file"
 when rmode="BOTH" then rmode="sub;file"
 when rmode="NONE" then rmode=""
end /*select*/
if debug then call _debug "LOG", "mode:"||mode||" report:"||rmode

/* MISCELLANEOUS MODES */
if mode="UNEXPLORED" then unvisited=1
else unvisited=_yesno("only probe unvisited sectors?")
autobuy=_yesno("autobuy eprobes?")
autovoid=_yesno("autovoid where probes are destroyed?")
if debug then call _debug "LOG", "unvisited:"||unvisited
if debug then call _debug "LOG", "autobuy:"||autobuy
if debug then call _debug "LOG", "autovoid:"||autovoid

/* GET MASK */
if rmode\="" then do
 call _newline _ansi("bt;fwh")
 call zocwriteln "the report mask tells the script which items to report."
 call zocwriteln "  0=class 0 ports   N=navhaz"
 call zocwriteln "  B=beacon          P=planets"
 call zocwriteln "  F=fighters        S=ships"
 call zocwriteln "  M=mines           T=traders"
 call zocwriteln "      *=ALL OF THE ABOVE"
 rmask=zocask("report mask?", rmask)
 if rmask="##CANCEL##" then call _quit "script cancelled by user"
 rmask=lower(rmask)
end /*if*/
if debug then call _debug "LOG", "mask:"||rmask

if mode="RANDOM" | mode="UNEXPLORED" then do
 call zocsend "v"
 if zocwait(", ports")=640 then call _error "timeout"
 parse value _lastline() with . "sectors " maxs ", ports"
 if zocwait("Command [")=640 then call _error "timeout"
end /*if*/
if debug then call _debug "LOG", "ns:"||maxs

target=_getnext(mode,target,fname,mins,maxs)

if pos("file",rmode)>0 then do
 if _fileopenw(rname) then do
  call lineout rname, ""
  call lineout rname, "EPROBE SESSION: "||date("N")||", "||time("N")
  call _fileclose rname
 end /*if*/
end /*if*/

call go_out

done=0
do while \done

 if unvisited & \(msg="##DESTROYED##" & autovoid) then do
  call zocsend "ci"||target||"^Mq"
  if zocwait("<Computer activated>")=640 then call _error "timeout"
  ans=zocwaitmux("has warps to sector(s)", "never visited sector")
  select
   when ans=0 then do
    msg="##SUCCESS##"
    sect=0
   end /*when*/
   when ans=1 then parse value _launchprobe(target, rmask, rmode, rname) with msg ";" sect
   when ans=640 then call _error "timeout"
   otherwise nop
  end /*select*/
 end /*if*/
 else parse value _launchprobe(target, rmask, rmode, rname) with msg ";" sect
if debug then call _debug "LOG", "launched:"||target||" "||msg||" "||sect

 select
  when msg="##NO PROBES##" & autobuy then do
   call come_in
   if _buyhardware("e0")=0 then done=1
   call go_out
  end
  when msg="##NO PROBES##" then done=1
  when msg="##NO PATH##" then target=_getnext(mode,target,fname,mins,maxs)
  when msg="##SUCCESS##" then target=_getnext(mode,target,fname,mins,maxs)
  when msg="##DESTROYED##" & autovoid then do
   call zocsend "^^s"||sect||"^Mq"
   if sect=target then target=_getnext(mode,target,fname,mins,maxs)
if debug then call _debug "LOG", "void:"||sect
  end /*when*/
  when msg="##DESTROYED##" then target=_getnext(mode,target,fname,mins,maxs)
  otherwise nop
 end /*select*/

 if target=0 then done=1

end /*while*/

call come_in

exit

_getnext:
 gnm=arg(1)
 gnt=arg(2)
 gnfname=arg(3)
 gnmin=arg(4)
 gnmax=arg(5)
 select

  when gnm="UNEXPLORED" then do
   if list="" | list="LIST" then do
    list=_getunexplored(gnt+1)
    if zocwait("Command [")=640 then call _error "timeout"
   end /*if*/
   parse var list gnr ";" list
   if gnr="" then gnr=0
if debug then call _debug "LOG", "unexplored list:"||_dwords(list,";")||" sectors in list"
  end /*when*/

  when gnm="RANDOM" then gnr=random(gnmin, gnmax)

  when gnm="FILE" then do
   if _fileeof(gnfname) then do
    call _fileclose gnfname
    gnr=0
   end /*if*/
   else gnr=strip(linein(gnfname))
   if gnr="" then do
    call _fileclose gnfname
    gnr=0
   end /*if*/
  end /*when*/

  otherwise gnr=0
 end /*select*/
return gnr

go_out:
return

come_in:
return

_halt: procedure expose (globals)
 call off halt
 call zocwriteln "^[[1;33m< user abort >^[[0m "
 exit
return

/***                 THE REVEREND'S TW LIBRARY FOR ZOC/REXX                 ***/

/** _setglobals v.3 **/
    _setglobals: procedure expose _verbose _monthdays _monthnames _baseday. (globals)
    
     _verbose=0
     _monthdays="31;28;31;30;31;30;31;31;30;31;30;31"
     _monthnames="jan;feb;mar;apr;may;jun;jul;aug;sep;oct;nov;dec"
     _baseday.2000=730118
     _baseday.2001=_baseday.2000+365+1
     _baseday.2002=_baseday.2001+365
     _baseday.2003=_baseday.2002+365
     _baseday.2004=_baseday.2003+365
     _baseday.2005=_baseday.2004+365+1
     _baseday.2006=_baseday.2005+365
     _baseday.2007=_baseday.2006+365
     _baseday.2008=_baseday.2007+365
    
     rslt="_g. _s. _p. _d. _v. _f. _m. _q. "
     rslt=rslt||"_ef. _es. _et. _ep. "
     rslt=rslt||"_path. _dist. _dtomsl. _dfrmsl. "
     rslt=rslt||"_bg. _nwi. _od. _sv. _pv. _bust. _vs. _vn. "
     rslt=rslt||"_olist1. _olist2. _clvlist1. _clvlist2. "
     rslt=rslt||"_verbose _monthdays _monthnames _baseday. "
     rslt=rslt||"globals reconnect scriptname lra "
     if arg(1,"E") then rslt=rslt||arg(1)
    
     rslt=_space(rslt)
    return rslt

/** _rseed v.7 **/
    _rseed: procedure expose (globals)
     if arg(1,"E") then width=min(max(arg(1),2),86400)
     else width=1000
     parse value time("L") with r1 ":" r2 ":" r3 "." r4
     r4=strip(left(r4,5))
     seed=r4||copies(0,5-length(r4))
     rslt=random(0, 99999, seed)//width
    return rslt

/** _pcheck v.4 **/
    _pcheck: procedure expose (globals)
     pc1=arg(1)
     pc2=zocgetscreen(0, zocgetinfo("CURSOR-Y"), zocgetinfo("CURSOR-X"))
     rslt=0
     do i=1 to _dwords(pc1,";")
      if _instr(_dword(pc1,i,";"),pc2,"cs") then rslt=1
     end /*do*/
    return rslt

/** _error v.7 **/
    _error: procedure expose (globals)
     call off halt
     if zocgetinfo("CURSOR-X")>0 then call zocwriteln
     call zocwrite _ansi("bt;frd")||"< script error"
     if arg(1,"E") then call zocwrite ": "||arg(1)
     call zocwriteln " >"
     call zocwriteln _ansi("bt;fye")||"< if this is a serious problem, email me at: the.reverend@coastgames.com > "
     call zocwriteln "< ZOC VERSION '"||zocgetinfo("VERSION")||"', OS '"||zocgetinfo("OSYS")||"', LOCATION '"||zocgetinfo("CONNECTEDTO")||"' >"
     if arg(2,"E") then call zocwriteln _ansi("bt;fgr")||"< "||arg(2)||" >"
     call zocwrite _ansi()
     call _beep "error.wav"
     if reconnect=1 & arg(1)="timeout" then do
      /* call zocdisconnect */
      call zocwriteln _ansi("bt;fwh")||"< ATTEMPTING TO RECONNECT >"
      call zocdostring "^RUN=_connect.zrx sn="||scriptname
     end /*if*/
    exit

/** _debug v.5 **/
    _debug: procedure expose (globals)
     if \arg(1,"E") | \arg(2,"E") then call _error "missing parameter in _debug"
     mode=strip(left(lower(arg(1)),3))
     msg=arg(2)
     if arg(3,"E") then logname=strip(arg(3))
     else logname="_debug.txt"
     select
      when mode="scr" then call zocwriteln "^[[1;34mREV-DEBUG <"||msg||">^[[0m"
      when mode="fed" then call zocsend "`REV-DEBUG <"||msg||">^M"
      when mode="sub" then call zocsend "'REV-DEBUG <"||msg||">^M"
      when mode="log" then do
       if _fileopenw(logname) then do
        call lineout logname, msg
        call _fileclose logname
       end /*if*/
       else call _error "unable to open rev-log.txt."
      end /*when*/
      otherwise nop
     end /*select*/
    return

/** _chooselist v.6 **/
    _chooselist: procedure expose (globals)
     prompt=arg(1)
     list=arg(2)
     if list="" then call _error "no list"
     delim=arg(3)
     if delim="" then delim=" "
     if length(delim)>1 then call _error "long delimiter"
    
     ch.=""
     i=_dwords(list,delim)
     do j=1 to i
      ch.j=_dword(list,j,delim)
     end /*do*/
    
     if i<7 then max=1
     if i<5 then max=0
     if i>=7 then max=(i-5)%2+1
    
     done=0
     loc=0
     do while \done
      if loc<0 then loc=0
      if loc>max then loc=max
    
      select
       when loc=0 then do
        if max=0 then rslt=zocrequest(prompt, ch.1, ch.2, ch.3, ch.4)
        else rslt=zocrequest(prompt, ch.1, ch.2, ch.3, "next")
       end /*when*/
       when loc=max then do
        p1=(loc-1)*2+4
        p2=p1+1
        p3=p1+2
        rslt=zocrequest(prompt, "back", ch.p1, ch.p2, ch.p3)
       end /*when*/
       otherwise do
        p1=(loc-1)*2+4
        p2=p1+1
        rslt=zocrequest(prompt, "back", ch.p1, ch.p2, "next")
       end /*otherwise*/
      end /*select*/
    
      select
       when rslt="next" then loc=loc+1
       when rslt="back" then loc=loc-1
       when rslt="##CANCEL##" then done=1
       when rslt="" then nop
       otherwise done=1
      end /*select*/
    
     end /*do*/
    
     if lower(arg(4))="c" & rslt="##CANCEL##" then call _quit "script cancelled by user.", "nocopy"
    
    return rslt

/** _asknum v.4 **/
    _asknum: procedure expose (globals)
     do i=1 to 3
      select
       when i=1 & arg(i,"E") then msg=arg(i)
       when i=1              then msg="enter an number:"
       when i=2 & arg(i,"E") then default=arg(i)
       when i=2              then default=""
       when i=3 & arg(i,"E") then cflag=min(verify(lower(arg(i)),"c","M"),1)
       when i=3              then cflag=0
       otherwise nop
      end /*select*/
     end /*do*/
     rslt=strip(zocask(msg, default))
     do while _stripnum(rslt)\=rslt | rslt=""
      default=rslt||" [please enter a number or ESC to cancel.]"
      if rslt="##CANCEL##" then leave
      else rslt=strip(zocask(msg, default))
     end /*do*/
     if cflag & rslt="##CANCEL##" then call _quit "script cancelled by user.", "nocopy"
    return rslt

/** _quit v.7 **/
    _quit: procedure expose (globals)
     lcpy=1
     arg1=""
     do i=1 to 2 /* manage arguments */
      select
       when arg(i,"E") & lower(arg(i))="nocopy" then lcpy=0
       when arg(i,"E") & arg1="" then arg1=arg(i)
       otherwise nop
      end /*select*/
     end /*do*/
     line=zocgetscreen(0, zocgetinfo("CURSOR-Y"), zocgetinfo("CURSOR-X"))
     select /* define message */
      when  lcpy & arg1="" then msg="^[[1;32m< end script >^[[0m^M^J"||line
      when \lcpy & arg1="" then msg="^[[1;32m< end script >^[[0m "
      when  lcpy           then msg="^[[1;32m^M^J< end script: "||arg1||" >^[[0m^M^J"||line
      when \lcpy           then msg="^[[1;32m^M^J< end script: "||arg1||" >^[[0m "
      otherwise nop
     end /*select*/
     call zocwrite msg
     select /* choose a beep */
      when lower(arg1)="script cancelled by user." then call _beep "cancel.wav"
      otherwise call _beep "quit.wav"
     end /*select*/
     exit
    return 1

/** _fileexists v.3 **/
    _fileexists: procedure expose (globals)
     if \arg(1,"E") then call _error "missing parameter in _fileexists"
     if stream(arg(1), "C", "QUERY EXISTS")="" then rslt=0; else rslt=1
    return rslt

/** _fileopenr v.4 **/
    _fileopenr: procedure expose (globals)
     if \arg(1,"E") then call _error "missing parameter in _fileopenr"
     if _fileexists(arg(1)) then do
      call stream arg(1), "C", "OPEN READ"
      rslt=_fileready(arg(1))
      if \rslt then call _fileclose arg(1)
     end /*if*/
     else rslt=0
    return rslt

/** _yesno v.3 **/
    _yesno: procedure expose (globals)
     if arg(1,"E") then msg=arg(1)
     else msg="yes or no"
     if arg(2)="yn" then rslt=zocrequest(msg||" (ESC=no)", "yes", "no")
                    else rslt=zocrequest(msg, "yes", "no", "cancel")
     select
      when rslt="cancel" then call _quit "script cancelled by user.", "nocopy"
      when rslt="##CANCEL##" & arg(2)\="yn" then call _quit "script cancelled by user.", "nocopy"
      when rslt="yes" then rslt=1
      otherwise rslt=0
     end /*select*/
    return rslt

/** _newline v.2 **/
    _newline: procedure expose (globals)
     if zocgetinfo("CURSOR-X")>0 then call zocwriteln arg(1)
     else call zocwrite arg(1)
    return

/** _ansi v.3 **/
    _ansi: procedure expose (globals)
     rslt="0"
     do i=1 to _dwords(arg(1),";")
      w=_dword(arg(1),i,";")
      select
       when w="dl"  then rslt=rslt||";"||0  /* dull               */
       when w="bt"  then rslt=rslt||";"||1  /* bright             */
       when w="ul"  then rslt=rslt||";"||4  /* underlined         */
       when w="blk" then rslt=rslt||";"||5  /* blinking           */
       when w="fbk" then rslt=rslt||";"||30 /* black foreground   */
       when w="frd" then rslt=rslt||";"||31 /* red foreground     */
       when w="fgr" then rslt=rslt||";"||32 /* green foreground   */
       when w="fye" then rslt=rslt||";"||33 /* yellow foreground  */
       when w="fbl" then rslt=rslt||";"||34 /* blue foreground    */
       when w="fmg" then rslt=rslt||";"||35 /* magenta foreground */
       when w="fcy" then rslt=rslt||";"||36 /* cyan foreground    */
       when w="fwh" then rslt=rslt||";"||37 /* white foreground   */
       when w="bbk" then rslt=rslt||";"||40 /* black background   */
       when w="brd" then rslt=rslt||";"||41 /* red background     */
       when w="bgr" then rslt=rslt||";"||42 /* green background   */
       when w="bye" then rslt=rslt||";"||43 /* yellow background  */
       when w="bbl" then rslt=rslt||";"||44 /* blue background    */
       when w="bmg" then rslt=rslt||";"||45 /* magenta background */
       when w="bcy" then rslt=rslt||";"||46 /* cyan background    */
       when w="bwh" then rslt=rslt||";"||47 /* white background   */
       otherwise nop
      end /*select*/
     end /*do*/
     rslt="^[["||rslt||"m"
    return rslt

/** _lastline v.3 **/
    _lastline: procedure expose (globals)
     rslt=zoclastline()
     select
      when lower(arg(1))="raw" then nop
      when pos(d2c(7),rslt)>0  then rslt=translate(zocstring("REMOVE", rslt, d2c(7)),"  ",d2c(0)||d2c(10))
      otherwise                     rslt=translate(rslt,"  ",d2c(0)||d2c(10))
     end /*select*/
    return rslt

/** _fileopenw v.3 **/
    _fileopenw: procedure expose (globals)
     if \arg(1,"E") then call _error "missing parameter in _fileopenw"
     if _fileexists(arg(1)) then do
      call stream arg(1), "C", "OPEN WRITE"
      call stream arg(1), "C", "SEEK <0"
      rslt=_fileready(arg(1))
      if \rslt then call _fileclose arg(1)
     end /*if*/
     else rslt=_filenew(arg(1))
    return rslt

/** _fileclose v.3 **/
    _fileclose: procedure expose (globals)
     if \arg(1,"E") then call _error "missing argument in _fileclose"
     call stream arg(1), "C", "CLOSE"
    return

/** _launchprobe v.5 **/
    _launchprobe: procedure expose (globals)
     dest=arg(1)
     mask=lower(arg(2))
     if pos("*",mask)>0 then mask="bptsfnm0"
     buflen=48*1024
    
     report=lower(arg(3)) /* fed;sub;file */
     fname=arg(4)
    
     if _sv.0="_SV.0" then _sv.=0
     if _p.0="_P.0" then _p.=""
     if _pv.0="_PV.0" then _pv.=0
     if _f.0="_F.0" then _f.=0
    
     rfed=0
     rsub=0
     rfile=0
     if pos("fed",report)>0 then rfed=1
     if pos("sub",report)>0 then rsub=1
     if pos("file",report)>0 then rfile=1
     ri=0
     msg="##SUCCESS##"
     sector=0
    
     ans=0
     call zocsend "e"
     do while ans<=0
      ans=zocwaitmux("SubSpace Ether Probe loaded in launch tube, ", ,
                     "You do not have any Ether Probes.", ,
                     "*** Error - No route", ,
                     "Launch aborted.", ,
                     "Probe Self Destructs", ,
                     "Probe Destroyed")
      lastline=strip(_lastline())
      select
       when ans=0 & pos("SubSpace",lastline)=1 then nop
       when ans=1 & pos("You do not have",lastline)=1 then nop
       when ans=2 & pos("*** Error",lastline)=1 then nop
       when ans=3 & pos("Launch aborted",lastline)=1 then nop
       when ans=4 & pos("Probe Self",lastline)=1 then nop
       when ans=5 & pos("Probe Destroyed",lastline)=1 then nop
       otherwise ans=-1
      end /*select*/
      if ans=0 then do
       call zocreceivebuf buflen
       call zocsend dest||"^M"
      end /*if*/
     end /*do*/
     buff=translate(zocreceivebuf(0),"  ",d2c(10)||d2c(0))
     if length(buff)=buflen then call _error "buffer overflow"
     select
      when ans=1 then msg="##NO PROBES##"
      when ans=2 then do
       msg="##NO PATH##"
       call zocsend "n"
       if zocwait("Launch aborted.")=640 then call _error "timeout"
      end /*when*/
      when ans=3 then do 
       msg="##SUCCESS##"
       sector=dest
      end /*when*/
      when ans<=5 then do
       i=max(pos("Probe entering sector",buff),1)
       j=pos("Probe Self Destructs",buff,i)+20
       if j=20 then do
        j=pos("Probe Destroyed",buff,i)+15
        msg="##DESTROYED##"
       end /*if*/
       buff=substr(buff,i,j-i)
       done=0
       i=1
       do while \done
      
        endrec=pos("Probe entering sector",buff,i+1)
        if endrec=0 then do
         rec=strip(substr(buff,i))
         done=1
        end /*if*/
        else rec=strip(substr(buff,i,endrec-i-1))
      
        cr=pos(d2c(13),rec)
        parse value left(rec,cr-1) with "Probe entering sector : " sector
        j=pos("Sector  : ",rec)
        if j>0 then do
         cr=pos(d2c(13),rec,j)
         parse value substr(rec,j,cr-1) with "Sector  : " sector .
         _sv.sector=1
        end /*if*/
      
        if pos("b",mask)>0 & (rfed | rsub | rfile) then do
         j=pos("Beacon  : ",rec)
         if j>0 then do
          cr=pos(d2c(13),rec,j)
          parse value substr(rec,j,cr-j) with "Beacon  : " beacon 
          ri=ri+1
          line.ri=_pad(sector,5,"L")||": Beacon - "||beacon
         end /*if*/
        end /*if*/
      
        if pos("0",mask)>0 & (rfed | rsub | rfile) then do
         j=pos("Ports   : ",rec)
         if j>0 then do
          cr=pos(d2c(13),rec,j)
          if substr(rec,j,cr-j)\="Ports   :  <=-DANGER-=>  Scanners indicate massive debris and heavy" then do
           parse value substr(rec,j,cr-j) with "Ports   : " name ", Class " typenum " (" typestr ")" .
           if typenum=0 then do
            ri=ri+1
            line.ri=_pad(sector,5,"L")||": "||name||", Class "||typenum||" ("||typestr||")"
            if _p.sector="" then _p.sector=typestr||";1,0;1,0;1,0"
            if \_pv.sector then _pv.sector=1
           end /*if*/
          end /*if*/
          else do
            ri=ri+1
            line.ri=_pad(sector,5,"L")||": PORT DESTROYED"
          end /*else*/
         end /*if*/
        end /*if*/
      
        if pos("p",mask)>0 & (rfed | rsub | rfile) then do
         planet.=""
         j=pos("Planets : ",rec)
         if j>0 then do
          cr=pos(d2c(13),rec,j)
          parse value strip(substr(rec,j,cr-j)) with "Planets : " planet.1
          j=cr+1
          cr=pos(d2c(13),rec,j)
          k=1
          do while substr(rec,j,10)="          " & j>0 & cr>0
           k=k+1
           parse value strip(substr(rec,j,cr-j)) with planet.k
           j=cr+1
           cr=pos(d2c(13),rec,j)
          end /*do*/
          do j=1 to k
           ri=ri+1
           line.ri=_pad(sector,5,"L")||": "||planet.j
          end /*if*/
         end /*if*/
        end /*if*/
      
        if pos("t",mask)>0 & (rfed | rsub | rfile) then do
         trader.=""
         j=pos("Traders : ",rec)
         if j>0 then do
          cr=pos(d2c(13),rec,j)
          parse value strip(substr(rec,j,cr-j)) with "Traders : " trader.1 ", w/ " trfigs " ftrs,"
          j=cr+1
          cr=pos(d2c(13),rec,j)
          parse value substr(rec,j,cr-j) with . "(" ship ")"
          trader.1=trader.1||" in "||ship||", "||trfigs||" fig(s)"
          j=cr+1
          cr=pos(d2c(13),rec,j)
          k=1
          do while substr(rec,j,10)="          " & j>0 & cr>0
           k=k+1
           parse value strip(substr(rec,j,cr-j)) with trader.k ", w/ " trfigs " ftrs,"
           j=cr+1
           cr=pos(d2c(13),rec,j)
           parse value substr(rec,j,cr-j) with . "(" ship ")"
           trader.k=trader.k||" in "||ship||", "||trfigs||" fig(s)"
           j=cr+1
           cr=pos(d2c(13),rec,j)
          end /*do*/
          do j=1 to k
           ri=ri+1
           line.ri=_pad(sector,5,"L")||": "||trader.j
          end /*if*/
         end /*if*/
        end /*if*/
      
        if pos("s",mask)>0 & (rfed | rsub | rfile) then do
         unmanned.=""
         j=pos("Ships   : ",rec)
         if j>0 then do
          cr=pos(d2c(13),rec,j)
          parse value strip(substr(rec,j,cr-j)) with "Ships   : " . "[Owned by] " unmanned.1 ", w/ " umfigs " ftrs,"
          j=cr+1
          cr=pos(d2c(13),rec,j)
          parse value substr(rec,j,cr-j) with . "(" ship ")"
          unmanned.1="("||unmanned.1||") "||ship||", "||umfigs||" fig(s)"
          j=cr+1
          cr=pos(d2c(13),rec,j)
          k=1
          do while substr(rec,j,10)="          " & j>0 & cr>0
           k=k+1
           parse value strip(substr(rec,j,cr-j)) with . "[Owned by] " unmanned.k ", w/ " umfigs " ftrs,"
           j=cr+1
           cr=pos(d2c(13),rec,j)
           parse value substr(rec,j,cr-j) with . "(" ship ")"
           unmanned.k="("||unmanned.k||") "||ship||", "||umfigs||" fig(s)"
           j=cr+1
           cr=pos(d2c(13),rec,j)
          end /*do*/
          do j=1 to k
           ri=ri+1
           line.ri=_pad(sector,5,"L")||": "||unmanned.j
          end /*if*/
         end /*if*/
        end /*if*/
      
        if pos("f",mask)>0 & (rfed | rsub | rfile) then do
         j=pos("Fighters: ",rec)
         if j>0 then do
          cr=pos(d2c(13),rec,j)
          parse value substr(rec,j,cr-j) with "Fighters: " figs " (" . ") [" . "]" .
          ri=ri+1
          line.ri=_pad(sector,5,"L")||": "||figs||" fig(s)"
          if \_f.sector then _f.sector=1
         end /*if*/
        end /*if*/
      
        if pos("n",mask)>0 & (rfed | rsub | rfile) then do
         j=pos("NavHaz  : ",rec)
         if j>0 then do
          cr=pos(d2c(13),rec,j)
          parse value substr(rec,j,cr-j) with "NavHaz  : " haz "%" .
          ri=ri+1
          line.ri=_pad(sector,5,"L")||": "||haz||"% NavHaz"
         end /*if*/
        end /*if*/
      
        if pos("m",mask)>0 & (rfed | rsub | rfile) then do
         j=pos("Mines   : ",rec)
         if j>0 then do
          cr=pos(d2c(13),rec,j)
          parse value substr(rec,j,cr-j) with "Mines   : " mamount " (Type" . mtype ") (" mowner ")"
          j=cr+1
          cr=pos(d2c(13),rec,j)
          mines=mamount||" "||mtype||"(s) ("||mowner||")"
          if substr(rec,j,10)="        : " then do
           parse value substr(rec,j,cr-j) with "        : " mamount " (Type" . mtype ") (" mowner ")"
           mines=mines||", "mamount||" "||mtype||"(s) ("||mowner||")"
          end /*if*/
          ri=ri+1
          line.ri=_pad(sector,5,"L")||": "||mines
         end /*if*/
        end /*if*/
      
        i=endrec
       end /*do*/
      end /*when*/
      when ans=640 then call _error "timeout"
      otherwise nop
     end /*select*/
    
     if msg="##DESTROYED##" & (rfed | rsub | rfile) then do
      ri=ri+1
      if sector=dest then line.ri=_pad(sector,5,"L")||": probe destroyed."
      else line.ri=_pad(sector,5,"L")||": probe destroyed enroute to sector "||dest||"."
     end /*if*/
    
     if msg="##NO PATH##" & (rfed | rsub | rfile) then do
      ri=ri+1
      line.ri=_pad(dest,5,"L")||": no route."
     end /*if*/
    
     if rfile & ri>0 then do
      if _fileopenw(fname) then do
       do i=1 to ri
        call lineout fname, strip(line.i)
       end /*do*/
       call _fileclose fname
      end /*if*/
     end /*if*/
    
     if rfed & ri>0 then do
      call zocsend "`^M"
      do i=1 to ri
       call zocsend strip(left(line.i,69))||"^M"
      end /*do*/
      call zocsend "^M"
     end /*if*/
    
     if rsub & ri>0 then do
      call zocsend "'^M"
      do i=1 to ri
       call zocsend strip(left(line.i,69))||"^M"
      end /*do*/
      call zocsend "^M"
     end /*if*/
    
     rslt=msg||";"||sector
    
    return rslt

/** _buyhardware v.5 **/
    _buyhardware: procedure expose (globals)
     sdfound=1
     list=arg(1)
     listq=""
    
     call zocsend "p"
     ans=zocwaitmux("There is no port in this sector!", ,
                    "<Q> Quit, nevermind", ,
                    "<S> Land on the StarDock")
     select
      when ans=0 then do
       if zocwait("Command [")=640 then call _error "timeout"
       call zocwrite _ansi("bt;fgr")||"<< stardock not available >> "||_ansi("fmg")
       sdfound=0
      end /*when*/
      when ans=1 then do
       call zocsend "q"
       if zocwait("Command [")=640 then call _error "timeout"
       call zocwrite _ansi("bt;fgr")||"<< stardock not available >> "||_ansi("fmg")
       sdfound=0
      end /*when*/
      when ans=2 then do
       call zocsend "s"
       ans2=zocwaitmux("and removal? : (Y/N)","<StarDock>")
       select
        when ans2=0 then call zocsend "y"
        when ans2=1 then nop
        when ans2=640 then call _error "timeout"
        otherwise nop
       end /*select*/
      end /*when*/
      when ans=640 then call _error "timeout"
      otherwise nop
     end /*select*/
    
     if sdfound then do
      zocsend "h"
      if zocwait("<Hardware Emporium>")=640 then call _error "timeout"
    
      do while list\=""
    
       parse var list item ";" list
       quant=_stripint(substr(item,2))
       item=upper(left(item,1))
       select
    
        when item="A" then do
         call zocsend "a"
         if zocwait("(Max ")=640 then call _error "timeout"
         if zocwait("[")=640 then call _error "timeout"
         avail=_stripint(_lastline())
         if quant=0 | quant>avail then quant=avail
         if avail=0 then quant=0
         call zocsend quant||"^M"
         if zocwait("<Hardware Emporium>")=640 then call _error "timeout"
        end /*when*/
    
        when item="E" then do
         call zocsend "e"
         if zocwait("(Max ")=640 then call _error "timeout"
         if zocwait("[")=640 then call _error "timeout"
         avail=_stripint(_lastline())
         if quant=0 | quant>avail then quant=avail
         if avail=0 then quant=0
         call zocsend quant||"^M"
         if zocwait("<Hardware Emporium>")=640 then call _error "timeout"
        end /*when*/
    
        when item="L" then do
         call zocsend "l"
         if zocwait("(Max ")=640 then call _error "timeout"
         if zocwait("[")=640 then call _error "timeout"
         avail=_stripint(_lastline())
         if quant=0 | quant>avail then quant=avail
         if avail=0 then quant=0
         call zocsend quant||"^M"
         if zocwait("<Hardware Emporium>")=640 then call _error "timeout"
        end /*when*/
    
        when item="M" then do
         call zocsend "m"
         if zocwait("(Max ")=640 then call _error "timeout"
         if zocwait("[")=640 then call _error "timeout"
         avail=_stripint(_lastline())
         if quant=0 | quant>avail then quant=avail
         if avail=0 then quant=0
         call zocsend quant||"^M"
         if zocwait("<Hardware Emporium>")=640 then call _error "timeout"
        end /*when*/
    
        when item="P" then do
         call zocsend "P"
         ans=zocwaitmux("not equipped to handle Photon Missiles!", "(Max ", "Photon Missiles are disabled")
         select
          when ans=0 then do
           if zocwait("<Hardware Emporium>")=640 then call _error "timeout"
           quant=0
           call zocwrite "<< ship not capable >>"
          end /*when*/
          when ans=1 then do
           if zocwait("[")=640 then call _error "timeout"
           avail=_stripint(_lastline())
           if quant=0 | quant>avail then quant=avail
           if avail=0 then quant=0
           call zocsend quant||"^M"
          if zocwait("<Hardware Emporium>")=640 then call _error "timeout"
          end /*when*/
          when ans=2 then do
           if zocwait("<Hardware Emporium>")=640 then call _error "timeout"
           quant=0
           call zocwrite "<< photons are disabled >>"
          end /*when*/
          when ans=640 then call _error "timeout"
          otherwise nop
         end /*select*/
        end /*when*/
    
        when item="T" then do
         call zocsend "t"
         if zocwait("(Max ")=640 then call _error "timeout"
         if zocwait("[")=640 then call _error "timeout"
         avail=_stripint(_lastline())
         if quant=0 | quant>avail then quant=avail
         if avail=0 then quant=0
         call zocsend quant||"^M"
         if zocwait("<Hardware Emporium>")=640 then call _error "timeout"
        end /*when*/
    
        otherwise quant=0
    
       end /*select*/
    
       if listq="" then listq=quant
       else listq=listq||";"||quant
    
      end /*do*/
    
      call zocsend "qq"
      if zocwait("Command [")=640 then call _error "timeout"
    
     end /*if*/
    
     else do
      do while list\=""
       parse var list . ";" list
       if listq="" then listq=0
       else listq=listq||";"||0
      end /*do*/
     end /*else*/
    
    return listq

/** _getunexplored v.2 **/
    _getunexplored: procedure expose (globals)
     min=arg(1)
     max=arg(2)
     if max="" then max=20000
     mode=arg(3)
     list=""
    
     if mode="" then do
      call zocsend "^^?"
      if zocwait("Interrogation Modes")=640 then call _error "timeout"
      if zocwait(":")=640 then call _error "timeout"
     end /*if*/
    
     line.=""
     done=0
     flag=0
     i=0
     len=0
    
     call zocsend "u"
     do while \done
      i=i+1
      if zocwait("^M")=640 then call _error "timeout"
      line.i=_space(_lastline(),1,";")
      parse value reverse(line.i) with sec ";" .
      if reverse(sec)>=min then len=len+length(line.i)+1
      if pos(";",line.i)>0 then flag=1
      if line.i="" then do
       i=i-1
       if flag then done=1
      end /*if*/
      else if reverse(sec)>max then done=1
      if len>350 then done=1
     end /*do*/
     imax=i
    
     if mode="" then do
      call zocsend " q"
      if zocwait("ENDINTERROG")=640 then call _error "timeout"
     end /*if*/
     else do
      call zocsend " "
      if zocwait(":")=640 then call _error "timeout"
     end /*else*/
    
     do i=1 to imax
      do while line.i\=""
       parse var line.i sec ";" line.i
       if sec>=min then do
        if list="" then list=sec
        else list=list||";"||sec
       end /*if*/
       if length(list)>244 then line.i=""
      end /*do*/
      if length(list)>244 then leave
     end /*do*/
    
    return list

/** _dwords v.2 **/
    _dwords: procedure expose (globals)
     rslt=words(translate(arg(1),arg(2)||" "," "||arg(2)))
    return rslt

/** _fileeof v.4 **/
    _fileeof: procedure expose (globals)
     rslt=\lines(arg(1))
    return rslt

/** _space v.1 **/
    _space: procedure expose (globals)
     str=strip(arg(1))
     if arg(2,"E") then n=arg(2); else n=1
     if arg(3,"E") then pad=arg(3); else pad=" "
     rslt=word(str,1)
     do i=2 to words(str)
      rslt=rslt||copies(pad,n)||word(str,i)
     end /*do*/
    return rslt

/** _instr v.3 **/
    _instr: procedure expose (globals)
     fnd=arg(1)
     str=arg(2)
     if lower(arg(3))\="cs" then do
      fnd=lower(fnd)
      str=lower(str)
     end /*if*/
     if arg(1,"E") & arg(2,"E") & pos(fnd,str)>0 then rslt=1
     else rslt=0
    return rslt

/** _dword v.2 **/
    _dword: procedure expose (globals)
     rslt=translate(word(translate(arg(1),arg(3)||" "," "||arg(3)),arg(2))," "||arg(3),arg(3)||" ")
    return rslt

/** _beep v.2 **/
    _beep: procedure expose (globals)
     select
      when arg(1,"O") then call zocwrite d2c(7)
      when _fileexists(arg(1)) then call zocplaysound arg(1)
      otherwise call zocwrite d2c(7)
     end /*select*/
    return

/** _stripnum v.3 **/
    _stripnum: procedure expose (globals)
     mask=_space(translate(arg(1)," ","-0123456789."," "),0)
     rslt=_space(translate(arg(1)," ",mask," "),0)
     if left(rslt,1)="-" then rslt="-"||_space(translate(rslt," ","-"),0)
     else rslt=_space(translate(rslt," ","-"),0)
     if _dwords(rslt,".")>2 then rslt=_dword(rslt,1,".")||"."||_space(translate(substr(rslt,pos(".",rslt)+1)," ","."),0)
     if \datatype(rslt,"N") then rslt=""
    return rslt

/** _fileready v.1 **/
    _fileready: procedure expose (globals)
     if \arg(1,"E") then call _error "missing parameter in _fileready"
     if stream(arg(1), "S")\="NOTREADY" then rslt=1; else rslt=0
    return rslt

/** _filenew v.4 **/
    _filenew: procedure expose (globals)
     if \arg(1,"E") then call _error "missing parameter in _filenew"
     if arg(2,"E") & lower(arg(2))="delete" then call dosdel arg(1)
     if _fileexists(arg(1)) then rslt=0
     else do
      call stream arg(1), "C", "OPEN WRITE"
      rslt=_fileready(arg(1))
      if \rslt then call _fileclose arg(1)
     end /*else*/
    return rslt

/** _pad v.1 **/
    _pad: procedure expose (globals)
     rslt=arg(1)
     if arg(2,"E") then w=arg(2); else return rslt
     if \arg(3,"E") then m="L"; else m=arg(3)
     select
      when m="L" then rslt=left(rslt,w)
      when m="R" then rslt=reverse(left(reverse(rslt),w))
      when m="C" then rslt=center(rslt,w)
      otherwise       rslt=left(rslt,w)
     end /*select*/
    return rslt

/** _stripint v.4 **/
    _stripint: procedure expose (globals)
     mask=_space(translate(arg(1)," ","-0123456789"," "),0)
     rslt=_space(translate(arg(1)," ",mask," "),0)
     if left(rslt,1)="-" then rslt="-"||_space(translate(rslt," ","-"),0)
     else rslt=_space(translate(rslt," ","-"),0)
     if \datatype(rslt,"W") then rslt=""
    return rslt